Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/pbuild6/frmproce.frm

Visual Basic Form | 1999-01-29 | 53.7 KB | 1,340 lines

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmProcedureBuilder
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "Procedure Builder"
   ClientHeight    =   4830
   ClientLeft      =   1215
   ClientTop       =   1905
   ClientWidth     =   9960
   BeginProperty Font
      Name            =   "Tahoma"
      Size            =   8.25
      Charset         =   0
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   Icon            =   "frmProcedureBuilder.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4830
   ScaleWidth      =   9960
   ShowInTaskbar   =   0   'False
   Begin VB.CheckBox chkStatic
      Caption         =   "All local variables as statics"
      Height          =   375
      Left            =   240
      TabIndex        =   35
      Top             =   3600
      Width           =   2295
   End
   Begin MSComctlLib.ListView lvParameters
      Height          =   1935
      Left            =   3120
      TabIndex        =   33
      Top             =   840
      Width           =   5895
      _ExtentX        =   10398
      _ExtentY        =   3413
      View            =   3
      LabelEdit       =   1
      LabelWrap       =   -1  'True
      HideSelection   =   -1  'True
      FullRowSelect   =   -1  'True
      _Version        =   393217
      ForeColor       =   -2147483640
      BackColor       =   -2147483643
      BorderStyle     =   1
      Appearance      =   1
      NumItems        =   4
      BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628}
         Text            =   "Parameters"
         Object.Width           =   2540
      EndProperty
      BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628}
         SubItemIndex    =   1
         Text            =   "Types"
         Object.Width           =   2540
      EndProperty
      BeginProperty ColumnHeader(3) {BDD1F052-858B-11D1-B16A-00C0F0283628}
         SubItemIndex    =   2
         Text            =   "Passed By"
         Object.Width           =   2540
      EndProperty
      BeginProperty ColumnHeader(4) {BDD1F052-858B-11D1-B16A-00C0F0283628}
         SubItemIndex    =   3
         Text            =   "Optional"
         Object.Width           =   2540
      EndProperty
   End
   Begin VB.CheckBox chkErrorOnly
      Caption         =   "Error Handling Only?"
      Height          =   255
      Left            =   240
      TabIndex        =   32
      Top             =   4380
      Width           =   2175
   End
   Begin VB.CheckBox chkCommentOnly
      Caption         =   "Comment Template Only ?"
      Height          =   255
      Left            =   3120
      TabIndex        =   31
      Top             =   4380
      Width           =   2175
   End
   Begin VB.TextBox txtOrganisation
      Height          =   360
      Left            =   2580
      TabIndex        =   1
      TabStop         =   0   'False
      Top             =   360
      Width           =   3495
   End
   Begin VB.TextBox txtAuthor
      Height          =   345
      Left            =   240
      TabIndex        =   0
      TabStop         =   0   'False
      Top             =   360
      Width           =   2190
   End
   Begin VB.CommandButton cmdDeleteParams
      Height          =   555
      Left            =   9240
      Picture         =   "frmProcedureBuilder.frx":0442
      Style           =   1  'Graphical
      TabIndex        =   28
      Top             =   1560
      Width           =   555
   End
   Begin VB.CheckBox chkOptional
      Caption         =   "Optional"
      Height          =   420
      Left            =   7950
      TabIndex        =   13
      Top             =   3030
      Width           =   975
   End
   Begin VB.ComboBox cmbByRef
      Height          =   315
      ItemData        =   "frmProcedureBuilder.frx":074C
      Left            =   6975
      List            =   "frmProcedureBuilder.frx":0756
      TabIndex        =   12
      Top             =   3150
      Width           =   915
   End
   Begin VB.ComboBox cmbParameterType
      Height          =   315
      ItemData        =   "frmProcedureBuilder.frx":0768
      Left            =   5610
      List            =   "frmProcedureBuilder.frx":0793
      Sorted          =   -1  'True
      TabIndex        =   11
      Top             =   3150
      Width           =   1365
   End
   Begin VB.CommandButton cmdAdd
      Height          =   555
      Left            =   9240
      Picture         =   "frmProcedureBuilder.frx":07FD
      Style           =   1  'Graphical
      TabIndex        =   14
      ToolTipText     =   "Add Parameters"
      Top             =   2175
      Width           =   540
   End
   Begin VB.TextBox txtParameterName
      Height          =   315
      Left            =   4065
      TabIndex        =   10
      Top             =   3150
      Width           =   1530
   End
   Begin VB.ComboBox cmbReturnType
      Height          =   315
      ItemData        =   "frmProcedureBuilder.frx":0B07
      Left            =   1200
      List            =   "frmProcedureBuilder.frx":0B2C
      Sorted          =   -1  'True
      TabIndex        =   5
      TabStop         =   0   'False
      Top             =   2400
      Visible         =   0   'False
      Width           =   1695
   End
   Begin VB.CheckBox chkCommentTemplate
      Caption         =   "Add Comment Template ?"
      Height          =   375
      Left            =   3120
      TabIndex        =   9
      Top             =   3960
      Value           =   1  'Checked
      Width           =   2295
   End
   Begin VB.CheckBox chkErrorHandling
      Caption         =   "Add Error Handling ?"
      Height          =   375
      Left            =   240
      TabIndex        =   8
      Top             =   3960
      Value           =   1  'Checked
      Width           =   1815
   End
   Begin VB.Frame frmType
      Height          =   720
      Left            =   240
      TabIndex        =   19
      Top             =   2820
      Width           =   2640
      Begin VB.OptionButton optFriend
         Caption         =   "Friend"
         Height          =   255
         Left            =   1680
         TabIndex        =   34
         Top             =   300
         Width           =   810
      End
      Begin VB.OptionButton optPrivate
         Caption         =   "Private"
         Height          =   375
         Left            =   840
         TabIndex        =   7
         Top             =   240
         Width           =   840
      End
      Begin VB.OptionButton optPublic
         Caption         =   "Public"
         Height          =   375
         Left            =   120
         TabIndex        =   6
         Top             =   240
         Value           =   -1  'True
         Width           =   735
      End
   End
   Begin VB.TextBox txtName
      Height          =   345
      Left            =   240
      TabIndex        =   2
      Top             =   1020
      Width           =   2175
   End
   Begin VB.Frame frmProcedureBuilder
      Height          =   735
      Left            =   255
      TabIndex        =   17
      Top             =   1440
      Width           =   2640
      Begin VB.OptionButton optFunction
         Caption         =   "Function"
         Height          =   375
         Left            =   1440
         TabIndex        =   4
         Top             =   240
         Width           =   1080
      End
      Begin VB.OptionButton optProcedure
         Caption         =   "Procedure"
         Height          =   255
         Left            =   270
         TabIndex        =   3
         Top             =   315
         Value           =   -1  'True
         Width           =   1335
      End
   End
   Begin VB.CommandButton CancelButton
      Caption         =   "Cancel"
      Default         =   -1  'True
      BeginProperty Font
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   8580
      TabIndex        =   16
      Top             =   4290
      Width           =   1215
   End
   Begin VB.CommandButton OKButton
      Caption         =   "OK"
      BeginProperty Font
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   8580
      TabIndex        =   15
      Top             =   3840
      Width           =   1215
   End
   Begin VB.Label lblOrganisation
      Caption         =   "Organisation"
      Height          =   315
      Left            =   2640
      TabIndex        =   30
      Top             =   120
      Width           =   1575
   End
   Begin VB.Label lblAuthor
      Caption         =   "Author"
      Height          =   300
      Left            =   240
      TabIndex        =   29
      Top             =   165
      Width           =   705
   End
   Begin VB.Label lblOptional
      Caption         =   "Optional"
      Height          =   255
      Left            =   7860
      TabIndex        =   27
      Top             =   1290
      Width           =   855
   End
   Begin VB.Label lblPassedBy
      Caption         =   "Passed By"
      Height          =   300
      Left            =   6945
      TabIndex        =   26
      Top             =   1275
      Width           =   915
   End
   Begin VB.Label lblArgPassed
      Caption         =   "Passed By"
      Height          =   270
      Left            =   6960
      TabIndex        =   25
      Top             =   2925
      Width           =   900
   End
   Begin VB.Label lblParameterTypes
      Caption         =   "Types"
      Height          =   255
      Left            =   5610
      TabIndex        =   24
      Top             =   1260
      Width           =   855
   End
   Begin VB.Label lblParameterType
      Caption         =   "Parameter Type"
      Height          =   255
      Left            =   5595
      TabIndex        =   23
      Top             =   2940
      Width           =   1245
   End
   Begin VB.Label lblParamNames
      Caption         =   "Parameter Name"
      Height          =   255
      Left            =   4080
      TabIndex        =   22
      Top             =   2940
      Width           =   1695
   End
   Begin VB.Label lblParameters
      Caption         =   "Parameters"
      Height          =   255
      Left            =   4080
      TabIndex        =   21
      Top             =   1260
      Width           =   1695
   End
   Begin VB.Label lblReturnType
      Caption         =   "Function Return Type"
      Height          =   255
      Left            =   1200
      TabIndex        =   20
      Top             =   2220
      Visible         =   0   'False
      Width           =   1695
   End
   Begin VB.Label lblName
      Caption         =   "Procedure/Function Name"
      Height          =   240
      Left            =   240
      TabIndex        =   18
      Top             =   780
      Width           =   1860
   End
Attribute VB_Name = "frmProcedureBuilder"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public VBInstance As vbide.VBE
Public Connect As Connect
Option Explicit
Private Sub chkErrorHandling_Click()
' Procedure chkErrorHandling_Click
' ----------------------------------------------------------------------
' Author        : Mark Kirkland
' Organisation  : Brighton Health Care
' Date          : 08/01/1999
' Description   :
' Amendments    :
' Error Handler
On Error GoTo chkErrorHandling_Click_Error:
' Disable error handling only unless error handling is selected
If Me.chkErrorHandling.Value = False Then
    Me.chkErrorOnly.Enabled = False
    Me.chkErrorOnly.Value = vbUnchecked
    Me.chkErrorOnly.Enabled = True
End If
Exit Sub
' Error Routine
chkErrorHandling_Click_Error:
MsgBox "Error # " & Err.Number & ": " & Err.Description & " In chkErrorHandling_Click"
End Sub
Private Sub chkCommentTemplate_Click()
' Procedure chkCommentTemplate_Click
' ----------------------------------------------------------------------
' Author        : Mark Kirkland
' Organisation  : Brighton Health Care
' Date          : 08/01/1999
' Description   :
' Amendments    :
' Error Handler
On Error GoTo chkCommentTemplate_Click_Error:
' Disable comment only unless comment template is true
If Me.chkCommentTemplate.Value = False Then
    Me.chkCommentOnly.Enabled = False
    Me.chkCommentOnly.Value = vbUnchecked
    Me.chkCommentOnly.Enabled = True
End If
Exit Sub
' Error Routine
chkCommentTemplate_Click_Error:
MsgBox "Error # " & Err.Number & ": " & Err.Description & " In chkCommentTemplate_Click"
End Sub
Private Sub Form_Load()
' Procedure Form_Load
' ----------------------------------------------------------------------
' Author        : Mark Kirkland
' Organisation  : Brighton Health Care NHS Trust
' Date          : 01/10/1998
' Description   :
' Amendments    :
' Error Handler
On Error GoTo Form_Load_Error:
' Declare variables
Dim strAuthor As String
Dim strOrganisation As String
' Get the author from the system registry
strAuthor = GetSetting(APP_NAME, "Author Details", "Author", "Mark Kirkland")
Me.txtAuthor.Text = strAuthor
' Get the organisation from the system registry
strOrganisation = GetSetting(APP_NAME, "Author Details", "Organisation", "Brighton Health Care")
Me.txtOrganisation.Text = strOrganisation
Exit Sub
' Error Routine
Form_Load_Error:
MsgBox "Error # " & Err.Number & ": " & Err.Description & " In Form_Load"
End Sub
Private Sub cmdDeleteParams_Click()
' Procedure cmdDeleteParams_Click
' ----------------------------------------------------------------------
' Author        : Mark Kirkland
' Organisation  : Brighton Health Care NHS Trust
' Date          : 30/09/1998
' Description   :
' Amendments    :
' Error Handler
On Error GoTo cmdDeleteParams_Click_Error:
' Variable Declarations
Dim I As Integer
Dim intSelectedList As Integer
Dim strSelectedKey As String
' Remove the parameters from the listview
strSelectedKey = Me.lvParameters.SelectedItem.Key
Me.lvParameters.ListItems.Remove strSelectedKey
Exit Sub
' Error Routine
cmdDeleteParams_Click_Error:
MsgBox "Error # " & Err.Number & ": " & Err.Description & " In cmdDeleteParams_Click"
End Sub
Private Sub CancelButton_Click()
' Procedure CancelButton_Click
' ----------------------------------------------------------------------
' Author        : Mark Kirkland
' Organisation  : Brighton Health Care NHS Trust
' Date          : 29/09/1998
' Description   : Clears and then hides the form on cancel
' Amendments    :
' Error Handler
On Error GoTo CancelButton_Click_Error:
' Declare variables
Dim strAuthor
Dim strOrganisation
    ' Check the registry settings and if necessary amend them
    ' First for the author
    If Len(Me.txtAuthor.Text) > 0 Then
        ' First check tha author settings
        strAuthor = GetSetting(APP_NAME, "Author Details", "Author", "Mark Kirkland")
        ' If the settings on the form differ then amend the registry
        If Trim$(strAuthor) <> Trim$(Me.txtAuthor.Text) Then
            SaveSetting APP_NAME, "Author Details", "Author", Trim$(Me.txtAuthor.Text)
        End If
    End If
    ' And next for the organisation
    If Len(Me.txtOrganisation.Text) > 0 Then
        ' First check tha organisation settings
        strOrganisation = GetSetting(APP_NAME, "Author Details", "Organisation", "Brighton Health Care")
        ' If the settings on the form differ then amend the registry
        If Trim$(strOrganisation) <> Trim$(Me.txtOrganisation.Text) Then
            SaveSetting APP_NAME, "Author Details", "Organisation", Trim$(Me.txtOrganisation.Text)
        End If
    End If
    ' Now clear the form to the default display
    Call ClearForm
    Connect.Hide
Exit Sub
' Error Routine
CancelButton_Click_Error:
MsgBox "Error # " & Err.Number & ": " & Err.Description & " In CancelButton_Click"
End Sub
Private Function CheckOptional() As Boolean
' Function CheckOptional
' ----------------------------------------------------------------------
' Author        : Mark Kirkland
' Organisation  : Brighton Health Care NHS Trust
' Date          : 29/09/1998
' Description   : Checks through the lvParameters listview control and ascertains
'                 whether any of the parameters that have already been entered are
'                 optional. If so then all other parameters should also be optional
' Amendments    :
' Error Handler
On Error GoTo CheckOptional_Error:
' Declare variables
Dim I As Integer    ' throwaway variable
Dim intListCount As Integer
' Initialise variables
intListCount = Me.lvParameters.ListItems.Count
' Check whether any parameters have been given
If intListCount > 0 Then
    For I = 1 To intListCount
        If Me.lvParameters.ListItems.Item(I).SubItems(3) = "True" Then
            CheckOptional = True
        End If
    Next I
End If

Exit Function
' Error Routine
CheckOptional_Error:
MsgBox "Error # " & Err.Number & ": " & Err.Description & " In CheckOptional"
CheckOptional = False
End Function
Private Function CreateErrorHandler() As String
' Function CreateErrorHandler
' ----------------------------------------------------------------------
' Author        : Mark Kirkland
' Organisation  : Brighton Health Care NHS Trust
' Date          : 29/09/1998
' Description   :
' Amendments    :
' Error Handler
On Error GoTo CreateErrorHandler_Error:
' Variable Declaration
Dim strOutput As String
    If Me.chkErrorHandling.Value = vbChecked Then
        ' Add the on error statement
        strOutput = strOutput & vbCrLf & "' Error Handler" & vbCrLf
        strOutput = strOutput & "On Error Goto " & Me.txtName.Text _
        & "_Error: "
        ' Mark where the user starts to place code
        strOutput = strOutput & vbCrLf & vbCrLf & "' PLACE CODE HERE !!!!!" & vbCrLf & vbCrLf
        If Me.optFunction.Value = True Then
        strOutput = strOutput & "Exit Function"
        Else
           strOutput = strOutput & "Exit Sub"
        End If
        ' Add the error handler label. What is added depends on whether we are in a
        ' class module or not.
        If VBC.Type = vbext_ct_ClassModule Then
            strOutput = strOutput & vbCrLf & vbCrLf & "' Error Routine " & vbCrLf & _
            Me.txtName.Text & "_Error:" & vbCrLf _
            & "Err.Raise Err.Number, " & """" & Me.txtName.Text & """" & ", Err.Description" _
            & vbCrLf
        Else
            strOutput = strOutput & vbCrLf & vbCrLf & "' Error Routine " & vbCrLf & _
            Me.txtName.Text & "_Error:" & vbCrLf _
            & "msgbox ""Error # "" & Err.Number & "": "" & Err.Description & "" In " & Trim$(Me.txtName.Text) & """" _
            & vbCrLf
        End If
    End If
' Return string back from function
CreateErrorHandler = strOutput
Exit Function
' Error Routine
CreateErrorHandler_Error:
MsgBox "Error # " & Err.Number & ": " & Err.Description & " In CreateErrorHandler"
CreateErrorHandler = "" ' Function failed so return an empty string
End Function
Private Function CreateComments(Author As String, Organisation As String _
, ProcedureName As String, TypeOfProc As String) As String
' Function CreateComments
' ----------------------------------------------------------------------
' Author        : Mark Kirkland
' Organisation  : Brighton Health Care NHS Trust
' Date          : 29/09/1998
' Description   :
' Amendments    :
' Error Handler
On Error GoTo CreateComments_Error:
' Declare variables
Dim strOutput As String
Dim I As Integer        ' Throwaway variable
Dim strAuthor As String
Dim strOrganisation As String
' Initialise variables
strAuthor = Author
strOrganisation = Organisation
    If Me.chkCommentTemplate.Value = vbChecked Then
        ' Fill in the type of procedure
        strOutput = strOutput & vbCrLf & "' " & TypeOfProc & " " & ProcedureName & vbCrLf
        ' Write a blank comment line
        strOutput = strOutput & "' "
        ' And write a line with 70 dashes "-" on it
        For I = 1 To 70
            strOutput = strOutput & "-"
        Next I
        ' Write a comment for the program author
        strOutput = strOutput & vbCrLf & "' Author" & vbTab & vbTab & ": " _
        & strAuthor & vbCrLf
        ' Write comment for the organisation
        strOutput = strOutput & "' Organisation " & vbTab & ": " & strOrganisation _
        & vbCrLf
        ' Write comment for the date
        strOutput = strOutput & "' Date " & vbTab & vbTab & vbTab & ": " & Format$(Date, "dd/mm/yyyy") _
        & vbCrLf
        ' Add a blank comment line
        strOutput = strOutput & "'" & vbCrLf
        ' Add the description comment
        strOutput = strOutput & "' Description" & vbTab & ":" & vbCrLf
        ' Add a blank line
        strOutput = strOutput & "'" & vbCrLf
        ' Add the amendments comment
        strOutput = strOutput & "' Amendments" & vbTab & ":" & vbCrLf
        ' Add a blank line
        strOutput = strOutput & "'" & vbCrLf
    End If
    ' Only place if there has been no error handling selected otherwise the
    ' CreateErrorHandler function will write this line
    If Me.chkErrorHandling.Value = vbUnchecked Then
        strOutput = strOutput & vbCrLf & vbCrLf & "' PLACE CODE HERE !!!!!" & vbCrLf & vbCrLf
    End If
' Pass the value back out of the function
CreateComments = strOutput
Exit Function
' Error Routine
CreateComments_Error:
MsgBox "Error # " & Err.Number & ": " & Err.Description & " In CreateComments"
CreateComments = ""     ' Function failed so return an empty string
End Function
Private Sub ClearForm()
' Procedure ClearForm
' ----------------------------------------------------------------------
' Author        : Mark Kirkland
' Organisation  : Brighton Health Care (NHS) Trust
' Date          : 29/09/1998
' Description   :
' Amendments    :
' Error Handler
On Error GoTo ClearForm_Error:
Dim ctlFormControls As Control
' Reset the form to the default values
For Each ctlFormControls In Me.Controls
    ' Clear all the textboxes Text property
    If TypeOf ctlFormControls Is TextBox Or TypeOf ctlFormControls Is ComboBox Then
        If ctlFormControls.Name <> "txtOrganisation" And ctlFormControls.Name <> "txtAuthor" Then
            ctlFormControls.Text = ""
        End If
    ' Check the Procedure and Public option buttons and uncheck the rest
    ElseIf TypeOf ctlFormControls Is OptionButton Then
        If ctlFormControls.Name = "optProcedure" Or ctlFormControls.Name = "optPublic" Then
            ctlFormControls.Value = True
        Else
            ctlFormControls.Value = False
        End If
    ' Check error handling and comment template checkboxes by default
    ElseIf TypeOf ctlFormControls Is CheckBox Then
        If ctlFormControls.Name = "chkCommentTemplate" Or ctlFormControls.Name = "chkErrorHandling" Then
            ctlFormControls.Value = vbChecked
        Else
            ctlFormControls.Value = vbUnchecked
        End If
    ' Clear the listview control
    ElseIf TypeOf ctlFormControls Is ListView Then
        ctlFormControls.ListItems.Clear
    End If
Exit Sub
' Error Routine
ClearForm_Error:
MsgBox "Error # " & Err.Number & ": " & Err.Description & " In ClearForm"
End Sub
Private Function CreateHeader() As String
' Function CreateHeader
' ----------------------------------------------------------------------
' Author        : Mark Kirkland
' Organisation  : Brighton Healthcare NHS Trust
' Date          : 29/09/1998
' Description   : Creates the string creating the sub or function header details
'               : The function takes information from the frmProcedureBuilder form
'               : Returns a string containing this information
' Amendments    :
' Error Handler
On Error GoTo CreateHeader_Error
' Declare variables
Dim strOutput As String ' String containing header information for procedure
Dim I As Integer ' Throwaway variable
    ' Now build the procedure definition starting with whether the procedure is
    ' private or public
    If Me.optPrivate.Value = True Then
        strOutput = "Private "
    ElseIf Me.optPublic.Value = True Then
        strOutput = "Public "
    ElseIf Me.optFriend.Value = True Then
        ' If a friend procedure is declared then check we are in a class module
        If VBC.Type = vbext_ct_ClassModule Then
            strOutput = "Friend "
        Else
            MsgBox "You can only use Friend in a Class Module" & vbCrLf & _
            "Defaulting to Private", vbInformation
            strOutput = "Private "
        End If
    End If
    ' Check whether this is a static procedure
    If Me.chkStatic.Value = vbChecked Then
        strOutput = strOutput & "Static "
    End If
    ' Now find out whether this is a procedure or a function
    ' This is a function
    If Me.optFunction.Value = True Then
        strOutput = strOutput & "Function " & Me.txtName.Text & " ("
        ' If parameters have been specified then include them in the header
        If Me.lvParameters.ListItems.Count > 0 Then
            For I = 1 To Me.lvParameters.ListItems.Count
                If Me.lvParameters.ListItems(I).SubItems(3) = "True" Then
                    strOutput = strOutput & "Optional "
                End If
                If Trim$(Me.lvParameters.ListItems(I).SubItems(2)) = "ByVal" Then
                    strOutput = strOutput & "ByVal "
                End If
                strOutput = strOutput & Me.lvParameters.ListItems(I).Key & " As " & _
                Me.lvParameters.ListItems(I).SubItems(1)
                ' Only add a comma if there is more than one parameter
                If I <> Me.lvParameters.ListItems.Count _
                And Me.lvParameters.ListItems.Count > 1 Then
                        ' Separate the parameters with a comma
                        strOutput = strOutput & ", "
                End If
            Next I
        End If
        ' Add the return parameter type
        strOutput = strOutput & ") As " _
        & Trim$(Me.cmbReturnType.Text) & vbCrLf
    ' This is a subroutine
    Else
        strOutput = strOutput & "Sub " & Me.txtName.Text & " ("
        If Me.lvParameters.ListItems.Count > 0 Then
            For I = 1 To Me.lvParameters.ListItems.Count
                If Me.lvParameters.ListItems(I).SubItems(3) = "True" Then
                    strOutput = strOutput & "Optional "
                End If
                If Trim$(Me.lvParameters.ListItems(I).SubItems(2)) = "ByVal" Then
                    strOutput = strOutput & "ByVal "
                End If
                strOutput = strOutput & Me.lvParameters.ListItems(I).Key & " As " & _
                Me.lvParameters.ListItems(I).SubItems(1)
                If I <> Me.lvParameters.ListItems.Count Then
                    ' Only add a comma if there is more than one parameter
                    If Me.lvParameters.ListItems.Count > 1 Then
                        ' Separate the parameters with a comma
                        strOutput = strOutput & ", "
                    End If
                End If
            Next I
        End If
        ' And add the final parenthesis
        strOutput = strOutput & ")" & vbCrLf
    End If
' Return the string for the program header
CreateHeader = strOutput
Exit Function
' Error Routine
CreateHeader_Error:
MsgBox "Error # " & Err.Number & ": " & Err.Description & " In CreateHeader"
' Error so return empty string
CreateHeader = ""
End Function
Private Sub cmdAdd_Click()
' Procedure cmdAdd_Click
' ----------------------------------------------------------------------
' Author        :
' Organisation  :
' Date          : 28/09/1998
' Description   :
' Amendments    :
' Error Handler
On Error GoTo cmdAdd_Click_Error:
' Declare variables
Dim booOptional As Boolean
Dim itmlist As ListItem
' Ensure that both the parameter name and type box are completed
If Len(Me.txtParameterName.Text) <> 0 Then
    If Me.cmbParameterType.Text = "" Then
        MsgBox "You Must Select a Parameter Type"
        Exit Sub
    End If
End If
If Len(Me.cmbParameterType.Text) <> 0 Then
    If Me.txtParameterName.Text = "" Then
        MsgBox "You Must Select a Parameter Name"
        Exit Sub
    End If
End If
If Len(Me.txtParameterName.Text) = 0 Then
    MsgBox "You Must Select a Parameter Name"
    Exit Sub
End If
If Len(Me.cmbParameterType.Text) = 0 Then
    MsgBox "You Must Select a Parameter Type"
    Exit Sub
End If
' Add the parameter to the listview
Set itmlist = Me.lvParameters.ListItems.Add(Key:=Me.txtParameterName.Text)
With itmlist
    .Text = Me.txtParameterName.Text
    .SubItems(1) = Me.cmbParameterType.Text
    If Len(Me.cmbByRef.Text) > 0 Then
        .SubItems(2) = Me.cmbByRef.Text
    Else
        .SubItems(2) = "ByRef"
    End If
    If Me.chkOptional.Value = vbChecked Then
        .SubItems(3) = "True"
    Else
        ' Check to see if any parameters have been included as optional
        ' in which case all other parameters will need to be optional too
        booOptional = CheckOptional
        If booOptional Then
            .SubItems(3) = "True"
        Else
            .SubItems(3) = "False"
        End If
    End If
End With
' And clear the textbox and listboxes for new input
Me.txtParameterName.Text = ""
Me.cmbParameterType.Text = ""
Me.cmbByRef.Text = ""
Me.chkOptional.Value = vbUnchecked
Exit Sub
' Error Routine
cmdAdd_Click_Error:
MsgBox "Error # " & Err.Number & ": " & Err.Description & " In cmdAdd_Click"
End Sub
Private Sub OKButton_Click()
' Procedure OKButton_Click
' ----------------------------------------------------------------------
' Author        : Mark Kirkland
' Organisation  : Brighton Health Care NHS Trust
' Date          : 12/01/1999
' Description   : Main routine for building the subroutine or function
' Amendments    :
' Declare variables
' Error Handler
On Error GoTo OKButton_Click_Error
Dim Counter As Integer  ' Loop counter
Dim intTop As Integer
Dim strProc As String       ' Contains the code for the method to be inserted into the current code pane
Dim I As Integer                ' Throwaway variable
Dim strAuthor As String     ' Author of the procedure
Dim strOrganisation As String   ' Organisation of the author (both these values can be changed and are stored in the registry)
Dim strCurrentProcedure As String
Dim booPropertyProcedure As Boolean
' Initialise property procedure boolean. Used to flag whether we are in a property
' procedure or not
booPropertyProcedure = False
' Check the registry settings and if necessary amend them
' First for the author
If Len(Me.txtAuthor.Text) > 0 Then
    ' First check tha author settings
    strAuthor = GetSetting(APP_NAME, "Author Details", "Author", "Mark Kirkland")
    ' If the settings on the form differ then amend the registry
    If Trim$(strAuthor) <> Trim$(Me.txtAuthor.Text) Then
        SaveSetting APP_NAME, "Author Details", "Author", Trim$(Me.txtAuthor.Text)
    End If
End If
' And next for the organisation
If Len(Me.txtOrganisation.Text) > 0 Then
    ' First check tha organisation settings
    strOrganisation = GetSetting(APP_NAME, "Author Details", "Organisation", "Brighton Health Care")
    ' If the settings on the form differ then amend the registry
    If Trim$(strOrganisation) <> Trim$(Me.txtOrganisation.Text) Then
        SaveSetting APP_NAME, "Author Details", "Organisation", Trim$(Me.txtOrganisation.Text)
    End If
End If
' Check that a parameter hasn't been entered and the user forgotten about it
If Len(Me.txtParameterName.Text) > 0 Then
    Call cmdAdd_Click
End If
' Find out which codepane is active
Set cpActCodePane = VBInstance.ActiveCodePane
' And get the active code module
Set cmCodeModule = cpActCodePane.CodeModule
' First check whether or not only a comment template is required
If Me.chkCommentOnly.Value = vbChecked And Me.chkCommentOnly.Enabled = True Then
    Call CreateCommentTemplateOnly
End If
' Then check whether or not only a generic error handler is required
If Me.chkErrorOnly.Value = vbChecked And Me.chkErrorOnly.Enabled = True Then
    Call CreateErrorHandlerOnly
End If
' Exit this procedure if either of the Comment Only or Error Only checkboxes
' was selected
If Me.chkCommentOnly.Value = vbChecked Or Me.chkErrorOnly.Value = vbChecked Then
    ' Clear the form to the default display
    Call ClearForm
    ' And tidy up the objects and close the form
    Set cpActCodePane = Nothing
    Set cmCodeModule = Nothing
    Connect.Hide
    Exit Sub
End If
' Then ascertain whether a procedure name has been given or not
If Me.txtName.Text = "" Then
    MsgBox "Must Give a Procedure Name"
    Me.txtName.SetFocus
    Exit Sub
    ' If building a function then ensure that a return type is given
    ' N.B. Decimal is currently not supported so is not an option
    If Me.optFunction.Value = True Then
        If Len(Me.cmbReturnType.Text) = 0 Then
            MsgBox "Must Have a Function Return Type"
            Me.cmbReturnType.SetFocus
            Exit Sub
        End If
    End If
End If

' Now build the procedure definition starting with the header
strProc = CreateHeader
' Next add the comment template if required
' -----------------------------------------------------------------------------------
If Me.optFunction.Value = True Then
    strProc = strProc & CreateComments(Trim$(Me.txtAuthor.Text), Trim$(Me.txtOrganisation.Text) _
, Me.txtName, "Function")
ElseIf Me.optFriend.Value = True Then
    strProc = strProc & CreateComments(Trim$(Me.txtAuthor.Text), Trim$(Me.txtOrganisation.Text) _
    , Me.txtName, "Friend")
ElseIf Me.optProcedure = True Then
    strProc = strProc & CreateComments(Trim$(Me.txtAuthor.Text), Trim$(Me.txtOrganisation.Text) _
    , Me.txtName, "Sub")
End If
' Add the error handling if specified
' -----------------------------------------------------------------------------------
strProc = strProc & CreateErrorHandler
' And add the end sub/function
' -----------------------------------------------------------------------------------
If Me.optFunction.Value = True Then
    strProc = strProc & vbCrLf & "End Function"
    strProc = strProc & vbCrLf & "End Sub"
End If
' And write to the code window
cmCodeModule.AddFromString strProc
' Get the first line of the added procedure by moving to the first line after the
' declarations section
Dim lngFromLine As Long
lngFromLine = 1 + cmCodeModule.CountOfDeclarationLines
' Now select the line where the first code will be inserted. Use an arbitrary
' value of 100 lines since the procedure template generated will never be this
' long. We are starting after the declarations section and since we used AddFromString
' we know that this will be the first line of the new procedure template
If cmCodeModule.Find("' PLACE CODE HERE !!!!!", lngFromLine, 1, 100, 1) Then
    cpActCodePane.SetSelection lngFromLine, 1, lngFromLine, 100
End If
cpActCodePane.Show
' Now clear the form to the default display
Call ClearForm
' And tidy up the objects and close the form
Set cpActCodePane = Nothing
Set cmCodeModule = Nothing
Connect.Hide
Exit Sub
' Error Routine
OKButton_Click_Error:
If Err.Number = 35 Then
    ' Check for error 35 so we can recognise property functions in classes
    Resume Next
    MsgBox "Error # " & Err.Number & ": " & Err.Description & " In OKButton_Click"
End If
End Sub
Private Sub optFriend_Click()
' Procedure optFriend_Click
' ----------------------------------------------------------------------
' Author        : Mark Kirkland
' Organisation  : Brighton Health Care NHS Trust
' Date          : 12/01/1999
' Description   :
' Amendments    :
' Error Handler
On Error GoTo optFriend_Click_Error
' If a friend procedure is declared then check we are in a class module
If VBC.Type <> vbext_ct_ClassModule Then
    MsgBox "You can only use Friend in a Class Module", vbInformation
    Me.optFriend.Value = False
End If
Exit Sub
' Error Routine
optFriend_Click_Error:
MsgBox "Error # " & Err.Number & ": " & Err.Description & " In optFriend_Click"
End Sub
Private Sub optFunction_Click()
' Error Handler
On Error GoTo optFunction_Click_Error
' If a function is selected then make the return type combo box visible
If Me.optFunction.Value = True Then
    Me.lblReturnType.Visible = True
    Me.cmbReturnType.Visible = True
    Me.lblReturnType.Visible = False
    Me.cmbReturnType.Visible = False
End If
' Successful Routine
Exit Sub
' Error Routine
optFunction_Click_Error:
MsgBox "Error #" & Err.Number & " : " & Err.Description & " In optFunction_Click"
End Sub
Private Sub optProcedure_Click()
' Error Handler
On Error GoTo optProcedure_Click_Error
' If a function is selected then make the return type combo box visible
' otherwise hide it
If Me.optProcedure.Value = True Then
    Me.lblReturnType.Visible = False
    Me.cmbReturnType.Visible = False
    Me.lblReturnType.Visible = True
    Me.cmbReturnType.Visible = True
End If
' Successful Routine
Exit Sub
' Error Routine
optProcedure_Click_Error:
MsgBox "Error #" & Err.Number & " : " & Err.Description & " In optProcedure_Click"
End Sub
Private Sub txtName_LostFocus()
' Error Handler
On Error GoTo txtName_Error
' Check that there are no spaces in the function or procedure name
If Not NoSpaces(Me.txtName.Text) Then
    MsgBox "Spaces Not allowed in Procedure Names"
    Me.txtName.SetFocus
End If
' Success
Exit Sub
' Error Routine
txtName_Error:
MsgBox "Error: " & Err.Number & " - " & Err.Description & " txtName_LostFocus"
End Sub
Private Sub CreateCommentTemplateOnly()
' Sub CreateCommentTemplateOnly
' ----------------------------------------------------------------------
' Author        : Mark Kirkland
' Organisation  : Brighton Health Care NHS Trust
' Date          : 27/01/1999
' Description   :
' Amendments    :
' Error Handler
On Error GoTo CreateCommentTemplateOnly_Error
' Declare variables
Dim strProcName As String
Dim lngFirstLine As Long
Dim lngFirstColumn As Long
Dim lngLastLine As Long
Dim lngLastColumn As Long
Dim lngProcFirstLine As String
Dim lngProcFirstLineGet As Long
Dim lngProcFirstLineLet As Long
Dim lngProcFirstLineSet As Long
Dim lngGet As Long
Dim lngSet As Long
Dim lngLet As Long
Dim strLine As String
Dim strProc As String
   ' Find out what line we are on at the moment
    cpActCodePane.GetSelection lngFirstLine, lngFirstColumn, lngLastLine, lngLastColumn
    ' And get the procedure name that we are in at the moment
    strProcName = cmCodeModule.ProcOfLine(lngFirstLine, vbext_pk_Proc)
    ' Now get the first line of this procedure or function
    ' A check will be done in the error handler for error 35 so regardless
    ' of which type of procedure the cursor is on we will be able to get the
    ' first line for it.
    ' Now check whether this is a subroutine a function or a property procedure
    lngProcFirstLine = cmCodeModule.ProcBodyLine(strProcName, vbext_pk_Proc)
    lngProcFirstLineGet = cmCodeModule.ProcBodyLine(strProcName, vbext_pk_Get)
    lngProcFirstLineLet = cmCodeModule.ProcBodyLine(strProcName, vbext_pk_Let)
    lngProcFirstLineSet = cmCodeModule.ProcBodyLine(strProcName, vbext_pk_Set)
    ' Unfortunately if error 35 is raised for vbext_pk_prop then all of the others
    ' will be set. So we find out which one is  closest to our current line.
    ' There must be an easier way to do this.........!!!!@@@@########*****
    lngGet = lngFirstLine - lngProcFirstLineGet
    lngSet = lngFirstLine - lngProcFirstLineSet
    lngLet = lngFirstLine - lngProcFirstLineLet
    ' We check which of the three variables lngGet, lngSet or lngLet is the smallest
    ' (and therefore closest to the current cursor position) taking into account the
    ' fact that the values could be negative. What a pain ...***###@@@!!! etc
    ' IF ANYONE KNOWS OF A NICE EASY WAY TO TELL WHETHER THE CURRENT CURSOR IS ON A
    ' PROPERTY LET,SET OR GET THEN PLEASE LET ME KNOW !!!!
    If (lngGet < IIf(lngSet < 0, lngGet + 1, lngSet)) And (lngGet < IIf(lngLet < 0, lngGet + 1, lngLet)) And (lngGet > 0) Then
        ' Procedure is property get
        lngProcFirstLine = lngProcFirstLineGet
    ElseIf (lngSet < IIf(lngGet < 0, lngSet + 1, lngGet)) And (lngSet < IIf(lngLet < 0, lngSet + 1, lngLet)) And (lngSet > 0) Then
        ' Procedure is property set
        lngProcFirstLine = lngProcFirstLineSet
    ElseIf (lngLet < IIf(lngGet < 0, lngLet + 1, lngGet)) And (lngLet < IIf(lngSet < 0, lngLet + 1, lngSet)) And (lngLet > 0) Then
        ' Procedure is property let
        lngProcFirstLine = lngProcFirstLineLet
    End If
    ' And finally we can get the first line of the procedure
    strLine = cmCodeModule.Lines(lngProcFirstLine, 1)
    ' Now check whether this is a subroutine a function or a property procedure
    If InStr(1, strLine, "Sub") Then
        lngProcFirstLine = cmCodeModule.ProcBodyLine(strProcName, vbext_pk_Proc)
        strProc = CreateComments(Trim$(Me.txtAuthor.Text), Trim$(Me.txtOrganisation.Text) _
        , strProcName, "Sub")
    ElseIf InStr(1, strLine, "Function") Then
        lngProcFirstLine = cmCodeModule.ProcBodyLine(strProcName, vbext_pk_Proc)
        strProc = CreateComments(Trim$(Me.txtAuthor.Text), Trim$(Me.txtOrganisation.Text) _
        , strProcName, "Function")
    ElseIf InStr(1, strLine, "Friend") Then
        lngProcFirstLine = cmCodeModule.ProcBodyLine(strProcName, vbext_pk_Proc)
        strProc = CreateComments(Trim$(Me.txtAuthor.Text), Trim$(Me.txtOrganisation.Text) _
        , strProcName, "Friend")
    ElseIf InStr(1, strLine, "Property Get") Then
        lngProcFirstLine = cmCodeModule.ProcBodyLine(strProcName, vbext_pk_Get)
        strProc = CreateComments(Trim$(Me.txtAuthor.Text), Trim$(Me.txtOrganisation.Text) _
        , strProcName, "Property Get")
    ElseIf InStr(1, strLine, "Property Set") Then
        lngProcFirstLine = cmCodeModule.ProcBodyLine(strProcName, vbext_pk_Set)
        strProc = CreateComments(Trim$(Me.txtAuthor.Text), Trim$(Me.txtOrganisation.Text) _
        , strProcName, "Property Set")
    ElseIf InStr(1, strLine, "Property Let") Then
        lngProcFirstLine = cmCodeModule.ProcBodyLine(strProcName, vbext_pk_Let)
        strProc = CreateComments(Trim$(Me.txtAuthor.Text), Trim$(Me.txtOrganisation.Text) _
        , strProcName, "Property Let")
    Else
        ' Generic error message
        MsgBox "Unrecognised routine type"
        Exit Sub
    End If
    ' Now create the comment template
    cmCodeModule.InsertLines lngProcFirstLine + 1, strProc
Exit Sub
' Error Routine
CreateCommentTemplateOnly_Error:
If Err.Number = 35 Then
    ' Check for error 35 so we can recognise property functions in classes
    Resume Next
    MsgBox "Error # " & Err.Number & ": " & Err.Description & " In CreateCommentTemplateOnly"
End If
End Sub
Private Sub CreateErrorHandlerOnly()
' Sub CreateErrorHandlerOnly
' ----------------------------------------------------------------------
' Author        :
' Organisation  :
' Date          : 27/01/1999
' Description   :   This routine creates and places in the routine under the cursor an error handler only. Used for existing
'                               routines where a generic error handler needs to be added after the the routine has been created
' Amendments    :
' Error Handler
On Error GoTo CreateErrorHandlerOnly_Error
' Declare variables
Dim strProcName As String                           ' Name of the procedure
Dim lngFirstLine As Long                                ' First line of the procedure that the cursor is on
Dim lngFirstColumn As Long                          ' First column of the procedure that the cursor is on
' We are not really interested in the following two variables. They are included because they are required parameters
' to the GetSelection method of the active code pane. Even if a selection of text was highlighted, the program would ignore
' this
Dim lngLastLine As Long
Dim lngLastColumn As Long
Dim lngCurrentLine As Long                          ' Stores the current line of the procedure as we move about in it
' The following variables get the first line of the procedure and take into account whether the procedure is a property
' procedure or a standard function or sub. This is a total kludge and there must be an easier way to do it.
Dim lngProcFirstLine As String
Dim lngProcFirstLineGet As Long
Dim lngProcFirstLineLet As Long
Dim lngProcFirstLineSet As Long
Dim lngGet As Long
Dim lngSet As Long
Dim lngLet As Long
Dim strLine As String                                       ' Holds the current line
Dim strProc As String                                       ' Holds the error handler template
Dim strFunctionType As String                   ' Holds the type of method (function,sub etc). This is added to the template
Dim booInsertError As Boolean               ' Used to throw us out of the loop which ascertains where the error handler is to be
                                                                            ' inserted
Dim I As Integer                                                ' Throwaway variable
Dim strCurrentCharacter  As String           ' Holds each character in the current line. Used to check where the error handler
                                                                            ' will be inserted
    ' Find out what line we are on at the moment
    cpActCodePane.GetSelection lngFirstLine, lngFirstColumn, lngLastLine, lngLastColumn
    ' And get the procedure name that we are in at the moment
    strProcName = cmCodeModule.ProcOfLine(lngFirstLine, vbext_pk_Proc)
    ' Now get the first line of this procedure or function
    ' A check will be done in the error handler for error 35 so regardless
    ' of which type of procedure the cursor is on we will be able to get the
    ' first line for it
    lngProcFirstLine = cmCodeModule.ProcBodyLine(strProcName, vbext_pk_Proc)
    lngProcFirstLineGet = cmCodeModule.ProcBodyLine(strProcName, vbext_pk_Get)
    lngProcFirstLineLet = cmCodeModule.ProcBodyLine(strProcName, vbext_pk_Let)
    lngProcFirstLineSet = cmCodeModule.ProcBodyLine(strProcName, vbext_pk_Set)
    ' Unfortunately if error 35 is raised for vbext_pk_prop then all of the others
    ' will be set. So we find out which one is  closest to our current line.
    ' There must be an easier way to do this.........!!!!@@@@########*****
    lngGet = lngFirstLine - lngProcFirstLineGet
    lngSet = lngFirstLine - lngProcFirstLineSet
    lngLet = lngFirstLine - lngProcFirstLineLet
    ' We check which of the three variables lngGet, lngSet or lngLet is the smallest
    ' (and therefore closest to the current cursor position) taking into account the
    ' fact that the values could be negative. What a pain ...***###@@@!!! etc
    ' IF ANYONE KNOWS OF A NICE EASY WAY TO TELL WHETHER THE CURRENT CURSOR IS ON A
    ' PROPERTY LET,SET OR GET THEN PLEASE LET ME KNOW !!!!
    If (lngGet < IIf(lngSet < 0, lngGet + 1, lngSet)) And (lngGet < IIf(lngLet < 0, lngGet + 1, lngLet)) And (lngGet > 0) Then
        ' Procedure is property get
        lngProcFirstLine = lngProcFirstLineGet
    ElseIf (lngSet < IIf(lngGet < 0, lngSet + 1, lngGet)) And (lngSet < IIf(lngLet < 0, lngSet + 1, lngLet)) And (lngSet > 0) Then
        ' Procedure is property set
        lngProcFirstLine = lngProcFirstLineSet
    ElseIf (lngLet < IIf(lngGet < 0, lngLet + 1, lngGet)) And (lngLet < IIf(lngSet < 0, lngLet + 1, lngSet)) And (lngLet > 0) Then
        ' Procedure is property let
        lngProcFirstLine = lngProcFirstLineLet
    End If
    ' Now check whether this line is a blank line or a comment line
    strLine = cmCodeModule.Lines(lngProcFirstLine, 1)
    ' And finally we can get the first line of the procedure
    strLine = cmCodeModule.Lines(lngProcFirstLine, 1)
    ' Now check whether this is a subroutine a function or a property procedure
    If InStr(1, strLine, "Sub") Then
        lngProcFirstLine = cmCodeModule.ProcBodyLine(strProcName, vbext_pk_Proc)
        strFunctionType = "Sub"
    ElseIf InStr(1, strLine, "Function") Then
        lngProcFirstLine = cmCodeModule.ProcBodyLine(strProcName, vbext_pk_Proc)
        strFunctionType = "Function"
    ElseIf InStr(1, strLine, "Property Get") Then
        lngProcFirstLine = cmCodeModule.ProcBodyLine(strProcName, vbext_pk_Get)
        strFunctionType = "Property"
    ElseIf InStr(1, strLine, "Property Set") Then
        lngProcFirstLine = cmCodeModule.ProcBodyLine(strProcName, vbext_pk_Set)
        strFunctionType = "Property"
    ElseIf InStr(1, strLine, "Property Let") Then
        lngProcFirstLine = cmCodeModule.ProcBodyLine(strProcName, vbext_pk_Let)
        strFunctionType = "Property"
    Else
        ' Generic error message
        MsgBox "Unrecognised routine type"
        Exit Sub
    End If
    ' Copy the line number for the start of the procedure to a variable to hold
    ' the current line of the procedure
    lngCurrentLine = lngProcFirstLine + 1
    ' And get the first line
    strLine = cmCodeModule.Lines(lngCurrentLine, 1)
    booInsertError = False
    Do Until booInsertError = True
        For I = 1 To Len(strLine)
            If Len(strLine) = 0 Then
                Exit For
            End If
            strCurrentCharacter = Mid$(strLine, I, 1)
            If strCurrentCharacter = "'" Then
                ' Check that we haven't got to the 'Place Code Here Prompt
                If Trim$(strLine) = "' PLACE CODE HERE !!!!!" Then
                    booInsertError = True
                    lngCurrentLine = lngCurrentLine - 1
                    Exit For
                End If
                Exit For
            ElseIf strCurrentCharacter <> " " Then
                ' The next character isn't a comment or a space so we need to insert
                ' the error handler here
                booInsertError = True
                lngCurrentLine = lngCurrentLine - 1
                Exit For
            End If
        Next I
        ' Get the next line to check
        lngCurrentLine = lngCurrentLine + 1
        strLine = cmCodeModule.Lines(lngCurrentLine, 1)
    Loop
    ' Insert the On Error Goto statement
    strProc = vbCrLf & "' Error Handler" & vbCrLf & "On Error Goto " & strProcName & "_Error" & vbCrLf
    cmCodeModule.InsertLines lngCurrentLine, strProc
    lngCurrentLine = lngCurrentLine + 4
    ' Now we need to move to the end of the procedure
    ' Create the end of the generic error handler
    If VBC.Type = vbext_ct_ClassModule Then
        strProc = vbCrLf & "Exit " & strFunctionType & vbCrLf & vbCrLf & "' Error Routine " _
        & vbCrLf & strProcName & "_Error:" & vbCrLf _
        & "Err.Raise Err.Number, " & """" & strProcName & """" & ", Err.Description" _
        & vbCrLf
    Else
        strProc = vbCrLf & "Exit " & strFunctionType & vbCrLf & vbCrLf & "' Error Routine " _
        & vbCrLf & strProcName & "_Error:" & vbCrLf & "msgbox ""Error # "" & Err.Number & "": "" & Err.Description & "" In " & strProcName & """" & vbCrLf
    End If
    ' First check whether we are already at the end of the procedure
    If Mid$(strLine, 1, 7) = "End Sub" Then
        cmCodeModule.InsertLines lngCurrentLine, strProc
    ElseIf Mid$(strLine, 1, 12) = "End Function" Then
        cmCodeModule.InsertLines lngCurrentLine, strProc
    ElseIf Mid$(strLine, 1, 12) = "End Property" Then
        cmCodeModule.InsertLines lngCurrentLine, strProc
    Else
        ' We will need to get to the end of the procedure
        Do
            strLine = cmCodeModule.Lines(lngCurrentLine, 1)
            If strFunctionType = "Sub" Then
                If Mid$(strLine, 1, 7) = "End Sub" Then
                    cmCodeModule.InsertLines lngCurrentLine, strProc
                    Exit Do
                End If
            ElseIf strFunctionType = "Function" Then
                If Mid$(strLine, 1, 12) = "End Function" Then
                    cmCodeModule.InsertLines lngCurrentLine, strProc
                    Exit Do
                End If
            ElseIf strFunctionType = "Property" Then
                If Mid$(strLine, 1, 12) = "End Property" Then
                    cmCodeModule.InsertLines lngCurrentLine, strProc
                    Exit Do
                End If
            End If
            lngCurrentLine = lngCurrentLine + 1
        Loop
    End If
Exit Sub
' Error Routine
CreateErrorHandlerOnly_Error:
If Err.Number = 35 Then
    ' Check for error 35 so we can recognise property functions in classes
    Resume Next
    MsgBox "Error # " & Err.Number & ": " & Err.Description & " In CreateErrorHandlerOnly"
End If
End Sub